home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 22 / Cream of the Crop 22.iso / program / eflibpt4.zip / DEMO / DATATYPE / STACK1.PAS < prev    next >
Pascal/Delphi Source File  |  1996-07-30  |  3KB  |  80 lines
  1. { Borland Pascal Extended Function Library - EFLIB (C) Johan Larsson, 1996
  2.   Demonstration; stacks #1
  3.  
  4.   EFLIB IS PROTECTED BY THE COPYRIGHT LAW AND MAY NOT BE COPIED, SOLD OR
  5.   MANIPULATED. FOR MORE INFORMATION, SEE PROGRAM MANUAL! THIS DEMONSTRAT-
  6.   ION PROGRAM MAY FREELY BE USED AND DISTRIBUTED.                          }
  7.  
  8.  
  9. uses EFLIBDEF, EFLIBINI, EFLIBBAS, EFLIBOBJ, EFLIBWIN, EFLIBDAT, EFLIBTXT,
  10.      EFLIBKBD;
  11.  
  12. var MyWindow : WindowObjectType;
  13.     MyStack : StackObjectType; Data : string[63]; Index : word;
  14.     NumberOfElements : word; StartMemory, MemoryUsed : longint; DataFlow : real;
  15.     RunTimer : TimerObjectType; Intact : boolean;
  16.  
  17.  
  18. begin
  19.      StartMemory := MemAvail; RunTimer.Initialize;
  20.  
  21.      RandSeed := 0; { Control random seed }
  22.  
  23.      with MyWindow do begin
  24.           InitializeWindow (1, 1, 80, 25, 'EFLIB', NoBorder, FALSE, FALSE);
  25.           SetTextCoordinates (4, 4, 77, 24);
  26.  
  27.           WriteLn ('@C@@LightGreen:Blue@* Stacks *');
  28.           WriteLn ('@C@@White:Blue@All data types have many common features. Stacks are');
  29.           WriteLn ('@C@useful when dealing with recursive problems.');
  30.           WriteLn ('@Yellow:Blue@'); LineFeed;
  31.  
  32.  
  33.           RunTimer.Reset;
  34.  
  35.           { Build queue }
  36.           WriteLn ('@LightRed:Blue@');
  37.           WriteLn ('Building a stack (adding as many element as memory can keep) ...');
  38.  
  39.           MyStack.InitializeStack (SizeOf(Data), { Element size }
  40.                                    TRUE); { Skip extra safety checkings }
  41.  
  42.           NumberOfElements := 0;
  43.           while MyStack.IsFree and not GlobalDataError do begin
  44.                 Inc (NumberOfElements);
  45.                 Data := StringGeneratedRandomly (Pred(SizeOf(Data)));
  46.                 MyStack.Push (Data);
  47.           end;
  48.  
  49.           MemoryUsed := (StartMemory - MemAvail);
  50.  
  51.           WriteLn ('@Yellow:Blue@Pops all elements from the stack ... ');
  52.           for Index := 1 to NumberOfElements do MyStack.Pop (Data);
  53.  
  54.           WriteLn ('@LightGreen:Blue@Done.');
  55.           WriteLn ('');
  56.           WriteLn ('');
  57.  
  58.           Intact := MyStack.IsIntact;
  59.  
  60.           { Intercept object (and dispose all elements from the heap) }
  61.           MyStack.Intercept;
  62.  
  63.           DataFlow := (MemoryUsed / (1 + RunTimer.ElapsedMS)) * 1e3;
  64.  
  65.           WriteLn ('@White:Blue@DATA FLOW ANALYZIS');
  66.           WriteLn ('@Yellow:Blue@Builded '+StringNumber(NumberOfElements, 0, 0)+' elements at '+
  67.                    StringNumber(RunTimer.ElapsedMS, 0, 0)+' ms, with an average data flow of '+
  68.                    StringNumber(DataFlow, 0, 0));
  69.           WriteLn ('byte per second and a total data allocation of '+StringNumber(MemoryUsed, 0, 0)+' bytes.');
  70.           WriteLn ('');
  71.  
  72.           WriteLn ('@White:Blue@');
  73.           WriteLn ('[Intact]  :  ' + StringBoolean (Intact));
  74.           WriteLn ('[Errors]  :  ' + StringBoolean (GlobalErrorFlag or GlobalDataError));
  75.  
  76.           repeat until Keyboard.KeyPressed;
  77.  
  78.           Intercept;
  79.      end;
  80. end.